00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES. LOAD WITH MSFAIL.FAI
00200		DATA FIB/.5/
00300	      DIMENSION XN(2000),RSTFAC(8),IV(78),LIST(200),PWDS(250),RN(2000)
00400		1,XWDS(250),STFF(8)
00500	C**** RN MIGHT HAVE TO BE 4000 ******
00600		COMMON /PX/POS,SX
00700	
00800	14	JT=0
00900		JR=0
01000		REWIND 1
01100	1	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
01200		TYPE 1
01300		ACCEPT 2,NAMX
01400	213	IF(LOOKD(NAMX).GE.0)GO TO 13
01500		TYPE 88,NAMX
01600		ACCEPT 2,L
01700		IF(L.EQ.'N')GO TO 14
01800	88	FORMAT(' WRITE OVER FILE ',A5,'????  '$)
01900	13	CALL OFILE(1,NAMX)
02000		XWDS(1)=1
02100		IF(JT.EQ.0)RM=0
02200		L=1
02210		JX=0
02300		LX=1
02400		LP=1
02410		IF(JT.NE.0)GO TO 84
02500	44	FORMAT(' TYPE TOP OUTPUT STAFF #  ',$)
02600		TYPE 44
02700		ACCEPT 5,RS
02750		RSX=RS
02760	C  SAVE UPPER STAFF NUM FOR NEXT FILE.
02800	10	IF(JT.EQ.0)GO TO 83
02900		NAME=NAME+2
03000		GO TO 84
03100	86	FORMAT(1XA5)
03200	3	FORMAT(' TYPE INPUT NAME, (CONT), (NOBAR)  ',$)
03300	83	TYPE 3
03400		ACCEPT 2,NAME,JT,NBAR
03500	C  TYPE ANY NUMBER AFTER NAME AND IT WILL GO TO NEXT LETTER IN ALPH.
03510		NAMZ=NAME
03600		IF(NBAR.NE.0)NBAR=-1
03700	C  ANY THIRD NUM. SUPPRESSES SCORE BARLINE FEATURE
03800	84	LK=LP
03900		IF(LOOKD(NAME))GO TO 284
03910		NAME=NAMZ+256
03920		IF(LOOKD(NAME).GE.0)GO TO 201
03930		NAMZ=NAME
04000	C  FOUND NO MORE TO READ
04100	284	TYPE 86,NAME
04200		JZ=0
04300		IF(RM.NE.0)GO TO 77
04400		RM=-1
04500	4	FORMAT(' TYPE INST NAME, (RESPC?) '$)
04600		TYPE 4
04700		ACCEPT 2,RNAM,NRS
04705	C  TYPE ANY NUM AFTER INS. NAME TO STOP RHYTH RESPACING.
04710		IF(RNAM.GT.0)REREAD 5,SN
04800		IF(INM.EQ.'99')GO TO 20
04900	CC	K=SN/100.
05000		TYPE 46
05100	46	FORMAT(' TRANS. NUM. -- '$)
05200		ACCEPT 5,TR
05300		IF(TR.GE.99)GO TO 83
05400	77	REWIND 21
05500	177	CALL IFILE(21,NAME)
05600		READ(21),ITEM,I,
05700		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
05800		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
05900	C TYPE 2ND NUM FOR TRANSPOSE, 3RD NUM FOR ALWAYS SAME STFF.
06000		DO 45 K=1,ITEM
06100		J=PWDS(K)
06200		IF(RN(J+1).NE.8)GO TO 45
06210		IF(RNAM)GO TO 145
06220		IF(RN(J+2).EQ.SN)GO TO 8 
06230		GO TO 45
06290	145	R9=RN(J+9)
06295		TYPE 86,R9
06300		IF(R9.NE.RNAM)GO TO 45
06400		SN=RN(J+2)
06500	C  FOUND THE STAFF
06600		GO TO 8
06700	45	CONTINUE
06800		L=JX
06900		LP=JY
07000		TYPE 16
07100	16	FORMAT(' STAFF NOT FOUND'/)
07200		GO TO 10
07300	8	DO 6 K=1,ITEM
07400		J=PWDS(K)
07410		R=RN(J+1)
07420		IF(R.NE.10)GO TO 800
07430		IF(RN(J).LT.6)GO TO 80
07440	C  FOUND A NUM. IN BOX ↓↓
07450		RN(J+2)=SN
07460		GO TO 81
07500	800	IF(R.NE.4)GO TO 80
07600		IF(NBAR)GO TO 80
07700		IF(RN(J).NE.2)GO TO 80
07800	C  FOUND A BAR LINE
07900		KB=RN(J+4)/100.
08000		RN(J+4)=1.+KB*100.
08100	C  KB IS FOR THICK BARS.
08200		R=RN(J+3)
08300		DO 82 KA=K+1,ITEM
08400		KB=PWDS(KA)
08500		IF(RN(KB+1).NE.4)GO TO 82
08600		IF(RN(KB).NE.2)GO TO 82
08700	C  AVOIDS DUPLICATE BARS.
08800		IF(ABS(R-RN(KB+3)).GT..5)GO TO 82	
08900		RN(KB+2)=99
09000		RN(KB+1)=0
09100	82	CONTINUE
09200		GO TO 81
09300	80	IF(RN(J+2).NE.SN)GO TO 6
09400		IF(RN(J+1).NE.8)GO TO 81
09500		IF(RN(J).LT.3)GO TO 81
09600		RN(J+4)=0
09700	C  SETS VERT. POS. OF STAFF TO 0.  WHAT ABOUT P5??!
09800	CC85	JZ=-1
09900	81	JA=PWDS(K+1)
10000		DO 7 KA=J,JA-1
10100		XN(LK)=RN(KA)
10200	7	LK=LK+1
10300		IF(L.GE.250)GO TO 150
10400		IF(LK.LE.2000)GO TO 50
10500	150	TYPE 9
10600		GO TO 20
10700	50	R=XN(LP+1)
11200		XN(LP+2)=RS
11300		L=L+1
11400		LP=LK
11500		XWDS(L)=LP
11600	6	CONTINUE
11700	17	JX=L
11800		JY=LP
11900		RS=RS-1
11910		IF(NRS.NE.0)GO TO 200
12000	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
12100		M=LX+1
12200		J=XWDS(LX)
12300		PWDS(LX)=XWDS(LX)
12400		I=LX
12500	24	RA=10000.
12600	C  POSITION
12700		DO 21 K=LX,L-1
12800		JL=XWDS(K)+3
12900		R=XN(JL)
13000		IF(R.EQ.10000)GO TO 21
13100		IF(ABS(R-RA).GT..1)GO TO 240
13200		R=RA
13300		XN(JL)=R
13400	C  PUT IN HERE MULTI-VOICE TRAP
13500		GO TO 21
13600	240	IF(R.GT.RA)GO TO 21
13700	C  LINES THEM UP
13800		I=K
13900		RA=R
14000	21	CONTINUE
14100		IF(RA.EQ.10000)GO TO 23
14200	C  JUMP IF ALL SORTED
14300		JL=XWDS(I)
14400		LA=JL
14500		N=XN(JL)+3
14600	C  NEXT POINTER
14700		PWDS(M)=PWDS(M-1)+N
14800		M=M+1
14900		DO 22 K=J,J+N-1
15000		RN(K)=XN(JL)
15100	22	JL=JL+1
15200		XN(LA+3)=10000
15300	C  PUT IT ASIDE
15400		J=N+J
15500		GO TO 24
15600	
15700	23	LB=LX
15710		JFST=0
15720		POS=0
15800	25	N=PWDS(LB)
15900		R=RN(N+1)
15910		IF(TR.EQ.0)GO TO 51
15915		IF(R.EQ.1)GO TO 52
15920		IF(R.EQ.5)GO TO 52
15925		IF(R.EQ.6)GO TO 52
15950		IF(R.EQ.17)GO TO 117
16000	51	IF(R.LE.4)GO TO 430
16050		IF(R.LT.17)GO TO 30
16075	C LOOKS FOR 17 AND 18, KSIG AND METER.
16100	430	IF(R.NE.1)GO TO 230
16200		IF(RN(N).LT.7)GO TO 30
16210		IF(RN(N+9))GO TO 30
16220	C SKIPS NON-LEDGER LINE NOTES.
16230		GO TO 530
16300	C  LOOK ONLY AT NOTES AND RESTS AND NON-DOUBLE STOPS, AND BARS,CLEFS
16310	230	IF(R.NE.2)GO TO 330
16320		IF(RN(N).LT.5)GO TO 30
16330	C JUMP IF NO RHYTH VALUE FOUND IN P7 (P9 FOR NOTES)
16335	530	IF(JFST.NE.0)GO TO 130
16340		JFST=LB+1
16345		POS=RN(N+3)
16350		GO TO 130
16360	330	IF(JFST.EQ.0)GO TO 30
16362	C  ONLY LOOKS AT ITEMS AFTER FIRST N0TE OR REST.
16365		IF(R.NE.4)GO TO 130
16382		IF(RN(N).NE.2)GO TO 30
16400	130	S=RN(N+3)
16500		LA=LB
16600	26	LA=LA+1
16700		IF(LA.GE.L)GO TO 30
16800	C  FIND NEXT IMPORTANT ITEM
16900		NA=PWDS(LA)
17000		RR=RN(NA+1)
17100		IF(RR.LE.4)GO TO 134
17150		IF(RR.LT.17)GO TO 26
17200	134	IF(RR.NE.4)GO TO 34
17300		IF(RN(NA).NE.2)GO TO 26
17400	C  USES ONLY NOTES, RESTS, BARS, CLEFS
17500	34	RX=RN(NA+3)
17600	C  POSITION OF NEXT ITEM
17700		IF(S.EQ.RX)GO TO 26
17800		A=RX-2
17900		IF(A.LT.S)A=S+.5
18000	C  SPACING WILL BEGIN NEARBY
18010		IF(R.LT.3)GO TO 235
18012		IF(R.GE.17)P=4.
18016	C  PUT IN FOR LARGE KSIGS LATER.
18020		IF(R.EQ.4)P=2.
18030		IF(R.EQ.3)P=6.
18040		IF(RN(NA+5).GE.100.)P=5.
18050	C SPACE FOR BARS, KSIG, METERS, CLEFS (LAST FOR MINI-CLEF)
18055		IF(RR.EQ.17)P=P+3.
18057	C  IF NEXT(RR) IS KSIG, ADD SPACE.
18060		GO TO 335
18100	235	K=9
18200		IF(R.EQ.2)K=7
18300		P=RN(N+K)
18400		P=P+(.125-P)*FIB
18500	135	P=P*15.
18600	C  FINDS RHYTH IN P9 OR P7(REST)
18700	C  IF DIFFERENT SIMULTANEOUS RHYTHMS, ZERO OUT LARGER BEFORE HAND.
18800		IF(P)GO TO 30
18900	C  SKIPS NOTES WITH SUPPRESSED LEDGER LINES.
19000	335	SX=S+P-RX
19100	C  SPACE DIFFERENCE
19200	35	DO 29 K=LX,L-1
19300		RR=SX
19400		NZ=PWDS(K)+3
19500		RA=RN(NZ)
19600	
19700		IF(RA.LT.A)RR=RR*(RA-S)/(A-S)
19750		IF(RA.GT.S)RN(NZ)=RA+RR	
19775		RR=SX
19800	C  A=BASIC POS. AT THIS TIME.
19900		R=RN(NZ-2)
20000		IF(R4567(R))GO TO 29
20100		NZ=NZ-3
20200		IF(RN(NZ).EQ.2)GO TO 29
20300		RB=RN(NZ+6)
20400		IF(RB.LT.A)RR=RR*(RB-S)/(A-S)
20500		IF(RB.GT.S)RN(NZ+6)=RB+RR
20600		IF(R.EQ.6)CALL BMQ(RN,NZ,A)
21600	29	CONTINUE
21700	30	LB=LB+1
21800		IF(LB.LT.L)GO TO 25
21900	C  GO BACK IF MORE SPACING TO DO
21950	
22000		SX=(200.-POS)/(RN(IFIX(PWDS(L-1)+3))-POS)
22100	C `SHRINK' FACTOR
22200		DO 31 K=JFST,L-1
22300		N=PWDS(K)+3
22400		RN(N)=POSX(RN(N))
22500		R=RN(N-2)
22600		IF(R4567(R))GO TO 31
22700		N=N-3
22800		IF(RN(N).EQ.2)GO TO 31
23000		RN(N+6)=POSX(RN(N+6))
23100		IF(RN(N+1).EQ.6)CALL BMQ(RN,N,-1000.)
24100	31	CONTINUE
24200		DO 32 K=IFIX(PWDS(LX)),IFIX(PWDS(L))
24300	32	XN(K)=RN(K)
24400		DO 33 K=LX,L
24500	33	XWDS(K)=PWDS(K)
24600	C  ALL DONE
24700	C****↑↑↑↑↑↑  RHYTH. RESET ↑↑↑↑↑↑↑↑↑↑↑
24800	200	LX=L
24900	
25000		IF(RS.GT.-4)GO TO 10
25100	20	L=JX-1
25200		J=1
25300		WRITE(1),L,JY,
25400		1 (XWDS(K),K=1,L+1),(XN(K),K=1,JY-1),J,J,J,J,RSTFAC,STFF,IV,STFF
25500	C  STUFF ON THE END IS FOR FORTRAN IO BUG.
25510		TYPE 86,NAMX
25600	15	END FILE 1
25700		IF(JT.EQ.0)CALL EXIT
25710		NAMX=NAMX+2
25712		TYPE 86,NAMX
25715		RS=RSX
25720		GO TO 213
25730	201	JT=0
25740		GO TO 20
25800	2	FORMAT(A5,2I)
25900	5	FORMAT(5F)
26000	9	FORMAT(' NO ROOM FOR THIS ONE')
26100	
26200	
26300	52	A=RN(N+4)
26400		RN(N+4)=A+TR
26500	C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
26600		X=RN(N+5)
26700		IF(RN(N+1).EQ.1)GO TO 11
26705	C  COULD ADD STEM REVERS HERE.
26800		RN(N+5)=X+TR
26900		GO TO 51
27000	11	IF(TR.NE.4)GO TO 1101
27100		IF(AMOD(A,7.0).EQ.0)GO TO 101
27200	1101	IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
27300	C  NEXT IS FOR Bb TRANSP.
27400		B=AMOD(A+7.0,7.0)
27500		IF(B.EQ.0)GO TO 101
27600		IF(B.NE.3)GO TO 51
27700	C  FINDS ORIG. E OR B
27800	101	M=AMOD(X,10.0)
27900	C  FINDS ACCID.
28000		X=X-M
28100	C  STEM DIR. AND DECI.
28200		B=3.
28300	C CHANGES FLAT TO NATURAL SIGN.
28400		IF(M.EQ.0.OR.M.EQ.3)B=2
28500	C  NO PROVISION YET FOR ## OR bb
28600	2101	RN(N+5)=X+B
28700		GO TO 51
28710	117	S=RN(N+5)
28720		IF(TR.EQ.1)S=S+2
28730		IF(TR.EQ.4)S=S+1
28740	C CHANGE KSIG FOR Bb AND F INSTS.  ADD CHECK-UP ABOVE LATER.
28745	C  MAKES NATURALS IF CHANGED TO NO KSIG (I.E. =0)
28747		IF(S.NE.0)GO TO 217
28748		IF(TR.EQ.1)S=-102
28749		IF(TR.EQ.3)S=-101
28750	217	RN(N+5)=S
28760		GO TO 51
28800		END
28900	
29000		FUNCTION R4567(R)
29100		R4567=0
29200		IF(R.LT.4)GO TO 1
29300		IF(R.LE.7)RETURN
29400	1	R4567=-1
29500		END
29600	
29700		SUBROUTINE BMQ(RN,NZ,A)
29800		DIMENSION RN(1)
30000		RR=RN(NZ)
30100		IF(RR.LT.7)RETURN
30200	C  FOR IRREGULAR BEAMS (THERE ARE AT LEAST 9 PARAMS.)
30300		IF(RR.NE.7)GO TO 129
30400	429	IF(RN(NZ+8).NE.0)GO TO 229
30500		RETURN
30600	129	IF(RN(NZ+10).EQ.0)GO TO 429
30700		IF(RN(NZ+10).LT.30)GO TO 229
30800		RB=RN(NZ+8)
30900		IF(RB.GT.A)RN(NZ+8)=BMX(RB,A)
31000	229	RB=RN(NZ+9)
31100		IF(RB.GT.A)RN(NZ+9)=BMX(RB,A)
31200		END
31300	
31400		FUNCTION BMX(RB,A)
31410		COMMON /PX/POS,SX
31500		BMX=RB+SX
31600		IF(A.EQ.-1000.)BMX=POSX(RB)
31700		END
31800	
32000		FUNCTION POSX(R)
32100		COMMON /PX/POS,SX
32200		POSX=POS+(R-POS)*SX
32300		END